home *** CD-ROM | disk | FTP | other *** search
/ The Very Best of Atari Inside / The Very Best of Atari Inside 1.iso / sharew / musik / spectrum / spektrum.a56 next >
Encoding:
Text File  |  1993-07-06  |  16.1 KB  |  321 lines
  1. include 'ioequ.inc'
  2.  
  3. hamtab    equ   $200                      ; Tabelle der Hamming-Fensterfunktion
  4. twiddel   equ   $300                      ; Tabelle der complexen Drehfaktoren
  5. arbber    equ   $400                      ; Arbeitsbereich
  6. zeitfkt   equ   $800                      ; Eingangszeitfunktion
  7. size      equ   512                       ; Groesse des Zeitfunktionsbuffers (2*nnn)
  8. nnn       equ   256                       ; nnn-Punkte FFT
  9. bits      equ   8                         ; nnn=2^bits
  10.  
  11.           org y:0
  12. logkonst  dc -0.8001568                   ; Konstanten fuer Logarithmusberechnung
  13.           dc  0.6042544
  14.           dc -0.4106065
  15.           dc  0.3010300
  16.  
  17.           org   x:0
  18. hamaddr   dc    hamtab                    ; Konstanten im x-Speicher ablegen,
  19. twaddr    dc    twiddel                   ; damit mit kuerzeren Befehlen darauf
  20. arbaddr   dc    arbber                    ; zugegriffen werden kann
  21. zeitaddr  dc    zeitfkt
  22. zfktnnn   dc    zeitfkt+nnn
  23. sendflag  dc    0
  24.  
  25.           org   p:$0
  26.           jmp   <start
  27.  
  28.           org   p:$0c                     ; ssi receive data
  29.           jsr   <ssirxd
  30.           org   p:$0e                     ; ssi receive data with Exception Status
  31.           jsr   <ssirxd
  32.           org   p:$10                     ; ssi transmit data
  33.           jsr   <ssitxd
  34.           org   p:$12                     ; ssi transmit data with Exception Status
  35.           jsr   <ssitxd
  36.  
  37.           org   p:$40
  38.  
  39. start     movep #1,x:m_pbc                ; Port B als Host-Interface
  40.           movec #size,m3                  ; modulo size adressierung
  41.           move  #zeitfkt,r3               ; Empfaengerzeiger
  42.           movec #size,m7
  43.           move  #zeitfkt+2,r7             ; Sendezeiger (vorlaufend)
  44.           movec #$ffff,m0                 ; lineare Addressierung
  45.           nop
  46.           movec m0,m1
  47.           movec m0,m2
  48.           movec m0,m4
  49.           movec m0,m5
  50.           movec m0,m6
  51.           movec #0,sp                     ; Stackpointer initialisieren
  52.           movec #$0300,sr                 ; niedrige interrupts aus
  53.           movep #0,x:m_bcr                ; keine Waits fuer externen Speicherzugriff
  54.           movec #0,sp                     ; Stackpointer initialisieren
  55.           movep #$4700,x:m_cra            ; ssi Kontrollregister A
  56.           movep #$0800,x:m_crb            ; ssi Kontrollregister B
  57.           movep #0,x:m_pcddr              ; port C ist ssi
  58.           movep #$01f8,x:m_pcc            ; ssi einschalten
  59.           movep #$2000,x:m_ipr            ; ssi interrupt auf level 1
  60.           movec #0,sr                     ; interrupts aktivieren
  61.           bset  #m_srie,x:<<m_crb         ; receiver interrupt einschalten
  62.           bset  #m_sre,x:<<m_crb          ; receiver einschalten
  63.           movep x:(r7),x:m_tx
  64.           bset  #m_stie,x:<<m_crb         ; transmitter interrupt einschalten
  65.           bset  #m_ste,x:<<m_crb          ; transmitter einschalten
  66.  
  67. warte0    jclr  #m_hf0,x:m_hsr,warte0     ; warte bis Host bereit
  68.  
  69. ;--------------------------------------------------------------------------------------------------
  70.  
  71. do_fft    jclr  #m_hf0,x:m_hsr,daswars    ; Wenn der Host nichts mehr will
  72.           move  r3,x0                     ; Teste, in welcher Haelfte gerade geschrieben wird
  73.           move  x:<zfktnnn,a              ; die Mitte des Zeitbuffers
  74.           cmp   x0,a
  75.           jpl   <unten                    ; wenn der Zeiger in der unteren Haelfte ist
  76. wartunt   move  r3,x0                     ; Zeiger ist oben, warte, bis er unten ist
  77.           cmp   x0,a
  78.           jmi   <wartunt
  79.           move  x:<zfktnnn,r5             ; Zeiger auf Zeitfunktion, obere Haelfte
  80.           jsr   <cp_x_arb                 ; copiere hammingbew. Zeitfkt in Arbbeitsber.
  81.           jsr   <fft                      ; berechne FFT
  82.           jsr   <logbetrag                ; berechne den Betrag (im x-Speicher des Arbeitsbereichs)
  83.           move  x:<zfktnnn,r5             ; Zeiger auf Zeitfunktion, obere Haelfte
  84.           jsr   <cp_x_back                ; zurueckkopieren
  85.           move  x:<zfktnnn,r5
  86.           jsr   <cp_y_arb                 ; copiere hammingbew. Zeitfkt in Arbbeitsber.
  87.           jsr   <fft                      ; berechne FFT
  88.           jsr   <logbetrag                ; berechne den Betrag (im x-Speicher des Arbeitsbereichs)
  89.           move  x:<zfktnnn,r5             ; Zeiger auf Zeitfunktion, obere Haelfte
  90.           jsr   <cp_y_back                ; zurueckkopieren
  91.           jmp   <do_fft                   ; weitermachen
  92. unten     move  r3,x0                     ; warte, bis er oben ist
  93.           cmp   x0,a
  94.           jpl   <unten
  95.           move  x:<zeitaddr,r5            ; Zeiger auf Zeitfunktion, untere Haelfte
  96.           jsr   <cp_x_arb                 ; copiere hammingbew. Zeitfkt in Arbbeitsber.
  97.           jsr   <fft                      ; berechne FFT
  98.           jsr   <logbetrag                ; berechne den Betrag (im x-Speicher des Arbeitsbereichs)
  99.           move  x:<zeitaddr,r5            ; Zeiger auf Zeitfunktion, untere Haelfte
  100.           jsr   <cp_x_back                ; zurueckkopieren
  101.           move  x:<zeitaddr,r5
  102.           jsr   <cp_y_arb                 ; copiere hammingbew. Zeitfkt in Arbbeitsber.
  103.           jsr   <fft                      ; berechne FFT
  104.           jsr   <logbetrag                ; berechne den Betrag (im x-Speicher des Arbeitsbereichs)
  105.           move  x:<zeitaddr,r5            ; Zeiger auf Zeitfunktion, untere Haelfte
  106.           jsr   <cp_y_back                ; zurueckkopieren
  107.           jmp   <do_fft                   ; weitermachen
  108.  
  109.  
  110. ;--------------------------------------------------------------------------------------------------
  111.  
  112. daswars   bclr  #m_srie,x:<<m_crb         ; receiver interrupt aus
  113.           bclr  #m_stie,x:<<m_crb         ; transmitter interrupt aus
  114.           movep #0,x:m_pcc                ; ssi ausschalten
  115.           stop
  116.  
  117. ;--------------------------------------------------------------------------------------------------
  118.  
  119. cp_x_arb  movec #0,m1                     ; reverse carry Adressierung
  120.           move  x:<hamaddr,r0             ; Zeiger auf Hammingtabelle
  121.           move  #nnn/2,n1                 ; fuer reverse carry im Arbeitsbereich
  122.           move  x:<arbaddr,r1             ; reverse carry Zeiger auf Arbeitsbereich
  123.           move  x:<arbaddr,r4             ; Zeiger auf Arbeitsbereich zum loeschen Imaginaerteil
  124.           move  #0,y0                     ; fuer Imaginaerteil
  125.           do    #nnn,cpzhax               ; so oft wie FFT gross
  126.             move  x:(r0)+,x0              ; Hammingwert holen
  127.             move  x:(r5)+,x1              ; Zeitwert holen
  128.             mpy   x0,x1,a       y0,y:(r4)+ ; Zeitwert hammingbewerten, Imaginaerteil loeschen
  129.             move  a,x:(r1)+n1             ; Hammingbewerteten Zeitwert im Realteil speichern
  130. cpzhax
  131.           movec #$ffff,m1
  132.           rts
  133.  
  134. ;--------------------------------------------------------------------------------------------------
  135.  
  136. cp_y_arb  movec #0,m1                     ; reverse carry Adressierung
  137.           move  x:<hamaddr,r0             ; Zeiger auf Hammingtabelle
  138.           move  #nnn/2,n1                 ; fuer reverse carry im Arbeitsbereich
  139.           move  x:<arbaddr,r1             ; reverse carry Zeiger auf Arbeitsbereich
  140.           move  x:<arbaddr,r4             ; Zeiger auf Arbeitsbereich zum loeschen Imaginaerteil
  141.           move  #0,y0                     ; fuer Imaginaerteil
  142.           do    #nnn,cpzhay               ; so oft wie FFT gross
  143.             move  x:(r0)+,x0              ; Hammingwert holen
  144.             move  y:(r5)+,x1              ; Zeitwert holen
  145.             mpy   x0,x1,a       y0,y:(r4)+ ; Zeitwert hammingbewerten, Imaginaerteil loeschen
  146.             move  a,x:(r1)+n1             ; Hammingbewerteten Zeitwert im Realteil speichern
  147. cpzhay
  148.           movec #$ffff,m1
  149.           rts
  150.  
  151. ;--------------------------------------------------------------------------------------------------
  152.  
  153. cp_x_back move  x:<arbaddr,r0             ; Zeiger auf Arbeitsbereich
  154.           do    #nnn,cpxloop              ; nnn Werte zurueckkopieren
  155.             move  x:(r0)+,x0
  156.             move  x0,x:(r5)+
  157. cpxloop
  158.           rts
  159. cp_y_back move  x:<arbaddr,r0             ; Zeiger auf Arbeitsbereich
  160.           do    #nnn,cpyloop              ; nnn Werte zurueckkopieren
  161.             move  x:(r0)+,x0
  162.             move  x0,y:(r5)+
  163. cpyloop
  164.           rts
  165.  
  166. ;--------------------------------------------------------------------------------------------------
  167.  
  168. fft       movec #$0400,sr                 ; scale down bit in Statusreg. setzen
  169.           move  #1,n1                     ; n1=Distanz-Startwert, (Abst. zw. ob. und unt. Fluegel)
  170.           move  #nnn,n6                   ; n6=twiddeloffset (Drehfaktorenabstand in Tabelle)
  171.           do    #bits,endfft              ; logarithmus zur Basis 2 von N mal
  172.             move  x:<arbaddr,r0           ; r0=Zeiger auf Eingangswert Butterfly (oberen Fluegel)
  173.             move  n1,a1                   ; Abstand der Fluegel berechnen (=2*Distanz)
  174.             lsl   a
  175.             move  a1,n2                   ; n2=Abstand der Fluegel
  176.             move  r0,r2                   ; r2=Zeiger auf ersten oberen Fluegel merken
  177.             move  n6,a1                   ; Drehfaktorenabstand halbieren
  178.             lsr   a
  179.             move  a1,n6                   ; merken
  180.             do    a1,nbutterfl            ; Drehfakt.abst. ist auch die Anzahl der Fluegel
  181.               move  x:<twaddr,r6          ; r6=Zeiger auf Anfang Drefaktorentabelle
  182.               move  r0,r1                 ; r1=Zeiger auf Eingangswert Butterfly (unterer Fluegel)
  183.               move  r0,r4                 ; r4=Zeiger auf Ausgangswert Butterfly (oberer Fluegel)
  184.               move  (r1)+n1               ; Zeiger auf unteren Fluegel richten
  185.               move  r1,r5                 ; r5=Zeiger auf Ausgangswert Butterfly (unterer Fluegel)
  186.  
  187.               ; oberer Fluegel:   A=ar+jai  (r0 ein, r4 aus)
  188.               ; unterer Fluegel:  B=br+jbi  (r1 ein, r5 aus)
  189.               ; Drehfaktor:       C=cr+jci
  190.  
  191.               ; A'=A+WB=ar'+jai'=(ar+cr*br-ci*bi)+j(ai+ci*br+cr*bi)
  192.               ; B'=A-WB=br'+jbi'=(ar-cr*br+ci*bi)+j(ai-ci*br-cr*br)=(2ar-ar')+j(2ai-ai')
  193.  
  194.               move              x:(r1),x1     y:(r6),y0   ; Register fuer Butterfly vorbesetzen
  195.               move                            y:(r0),b
  196.               do    n1,butterfl                           ; Butterfly fuer n1 Fluegel berechnen
  197.                 mac   y0,x1,b   x:(r6)+n6,x0  y:(r1)+,y1
  198.                 macr  x0,y1,b                 y:(r0),a
  199.                 subl  b,a       x:(r0),b      b,y:(r4)
  200.                 mac   x0,x1,b   x:(r0)+,a     a,y:(r5)
  201.                 macr  -y0,y1,b  x:(r1),x1     y:(r6),y0
  202.                 subl  b,a       b,x:(r4)+     y:(r0),b
  203.                 move            a,x:(r5)+
  204. butterfl
  205.               move  (r2)+n2               ; Zeiger auf naechsten Butterfly berechnen
  206.               move  r2,r0                 ; und Zeiger auf oberen Fluegel darauf richten
  207. nbutterfl
  208.             move  n2,n1                   ; Neue Distanz = alter Fluegelabstand
  209. endfft
  210.           rts
  211.  
  212. ;--------------------------------------------------------------------------------------------------
  213.  
  214. logbetrag movec #0,sr                     ; Statusregister Initialisieren
  215.           move  #arbber+1,r0              ; r0=Zeiger auf Eingangswert (Tabellenanfang)
  216.           move  #arbber+nnn-1,r1          ; r1=Zeiger auf Ausgangswert (Tabellenende)
  217.           move  r0,r4                     ; r4=Zeiger auf Ausgangswert (Tabellenanfang)
  218.           move  r1,r5                     ; r5=zeiger auf Eingangswert (Tabellenende)
  219.  
  220.           ; A=ar+jai        (r0 ein)
  221.           ; B=br+jbi        (r5 ein)
  222.  
  223.           ; B=A*            (B und A sind konjugiert Komplex)
  224.           ; lg(|A|^2)=lg(|B|^2)=lg(ar*br-ai*bi)
  225.  
  226.           move              x:(r0),x0     y:(r5),y0
  227.           move              x:(r5)-,x1    y:(r0)+,y1
  228.           do    #nnn/2,betrloop
  229.             mpy   x0,x1,a                 ; quadrieren
  230.             mpy   y0,y1,b
  231.             sub   b,a
  232.             move            a,x:(r1)-     ; Betragsquadrate im x-Speicher ablegen
  233.  
  234.             ; Berechnet log10(a) auf 2 Dezimalstellen nach dem Komma genau
  235.             ; durch quatratisch Naeherung
  236.             ; Eingang: a, Ausgang: b
  237.             ; Zahlendarstellung fuer Ausgangswert:
  238.             ;   Kennzahl*65536+Mantisse
  239.  
  240.             clr   b
  241.             cmp   a,b                     ; test, ob Eingangswert<=0
  242.             move  b0,r2                   ; Exponenten rueckstzen
  243.             jge   <logundef               ; wenn Zahl <=0, undefiniert
  244.             move  a1,x0                   ; sonst oberen Teil testen
  245.             cmp   x0,b                    ; wenn oberer Teil!=0,
  246.             jne   <logloop                ; dann normal log berechnen
  247.             move  #<24,r2                 ; sonst nur a0>0, Exponenten erhoehen
  248.             move  a0,a1                   ; und unteren Teil heranziehen
  249.             move  b0,a0
  250.             asr   a         (r2)-         ; ersten Schleifendurchlauf korrigieren
  251. logloop     asl   a         (r2)+         ; Exponenten ermitteln (in r2 zaehlen)
  252.             jec   <logloop
  253.             asr   a         (r2)-         ; Exponent ist eins zu hoch
  254.             move  r2,x0                   ; Exponenten merken
  255.             move  #logkonst,r2            ; Konstantentabelle
  256.             move  a,y0                    ; Mantisse     (x)
  257.             mpy   y0,y0,a                 ; Mantisse^2   (x^2)
  258.             move  a,x1                    ; merken
  259.             move  y:(r2)+,a               ; konsta0 in a_accu (y=a0)
  260.             move  y:(r2)+,y1              ; konsta1 in y1
  261.             mpy   +y0,y1,b    y:(r2)+,y1  ; (a1/2*x) in b_accu, konsta2 in y1
  262.             addl  a,b         x:(r5),x1   ; (y=a0+a1*x) in b_accu, x1 fuer Betragsberech. laden
  263.             mac   +x1,y1,b    y:(r2)+,y1  ; (y=a0+a1*x+a2*x^2) in b_accu, y1 fuer Betrag
  264.             asr b                         ; normieren (die rep-Anweisung ist hier nicht geeignet,
  265.             asr b                         ; da sie von Interrupts nicht unterbrochen werden kann.)
  266.             asr b
  267.             asr b
  268.             asr b
  269.             asr b
  270.             asr b
  271.             mpy   x0,y1,a     y:(r5)-,y0  ; Kennziffer berechnen, y0 fuer Betrag
  272.             asr a                         ; passend machen
  273.             asr a
  274.             asr a
  275.             asr a
  276.             asr a
  277.             asr a
  278.             asr a
  279.             asr a
  280.             move  a0,y1                   ; und zur Mantisse dazu
  281.             sub   y1,b        x:(r0),x0   ; x0 fuer Betrag
  282.             jmp   <logend
  283. logundef    move  #$ce0000,b              ; Wert fuer ungueltig (-50)
  284.  
  285. logend      move  b,x:(r4)+   y:(r0)+,y1  ; und speichern
  286. betrloop
  287.           move  #$800000,x0               ; Endekennzeichen
  288.           move  x0,x:(r4)+
  289.           rts
  290.  
  291. ;--------------------------------------------------------------------------------------------------
  292.  
  293. ssirxd    jclr  #<m_sre,x:m_crb,ssirxdy   ; abwechselnd in x u. y ablegen, Flag: sre
  294.           movep x:m_rx,x:(r3)             ; 1. Wert in x-Speicher ablegen
  295.           bclr  #<m_sre,x:<<m_crb         ; Flag setzen
  296.           rti
  297. ssirxdy   movep x:m_rx,y:(r3)+            ; 2. Wert in y-Speicher ablegen
  298.           bset  #<m_sre,x:<<m_crb         ; receiver fuer naechsten Frame aktivieren
  299.           rti
  300.  
  301. ssitxd    jset  #<1,x:<sendflag,ssitxdx   ; abwechselnd x u. y senden, Flag: sendflag
  302.           movep y:(r7)+,x:m_tx            ; 2. Wert senden
  303.           bset  #<1,x:<sendflag           ; Flag setzen
  304.           rti
  305. ssitxdx   movep x:(r7),x:m_tx             ; 1. Wert ins Senderegister
  306.           bclr  #<1,x:<sendflag           ; Flag loeschen
  307.           bclr  #<m_ste,x:<<m_crb         ; Senden nach Wert in Schiebereg. stoppen
  308.           bset  #<m_ste,x:<<m_crb
  309.           rti
  310.  
  311. ;--------------------------------------------------------------------------------------------------
  312.  
  313.           org   x:hamtab
  314. include 'ham256.a56'
  315.  
  316.           org   x:twiddel
  317. include 'tw128x.a56'
  318.           org   y:twiddel
  319. include 'tw128y.a56'
  320.  
  321. end